home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / xlib / yicons24 / source / soundtst.prj < prev    next >
Text File  |  1993-03-05  |  7KB  |  258 lines
  1. eat
  2.     Color := RandColor;
  3.     SetColor(Color);
  4.     SetFillStyle(Random(CloseDotFill)+1, Color);
  5.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  6.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  7.   until KeyPressed;
  8.   WaitToGo;
  9. end; { RandBarPlay }
  10.  
  11. procedure ArcPlay;
  12. { Draw random arcs on the screen }
  13. var
  14.   MaxRadius : word;
  15.   EndAngle : word;
  16.   ArcInfo : ArcCoordsType;
  17. begin
  18.   MainWindow('Arc / GetArcCoords demonstration');
  19.   StatusLine('Esc aborts or press a key');
  20.   MaxRadius := MaxY div 10;
  21.   repeat
  22.     SetColor(RandColor);
  23.     EndAngle := Random(360);
  24.     SetLineStyle(SolidLn, 0, NormWidth);
  25.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  26.     GetArcCoords(ArcInfo);
  27.     with ArcInfo do
  28.     begin
  29.       Line(X, Y, XStart, YStart);
  30.       Line(X, Y, Xend, Yend);
  31.     end;
  32.   until KeyPressed;
  33.   WaitToGo;
  34. end; { ArcPlay }
  35.  
  36. procedure PutPixelPlay;
  37. { Demonstrate the PutPixel and GetPixel commands }
  38. const
  39.   Seed   = 1962; { A seed for the random number generator }
  40.   NumPts = 2000; { The number of pixels plotted }
  41.   Esc    = #27;
  42. var
  43.   I : word;
  44.   X, Y, Color : word;
  45.   XMax, YMax  : integer;
  46.   ViewInfo    : ViewPortType;
  47. begin
  48.   MainWindow('PutPixel / GetPixel demonstration');
  49.   StatusLine('Esc aborts or press a key...');
  50.  
  51.   GetViewSettings(ViewInfo);
  52.   with ViewInfo do
  53.   begin
  54.     XMax := (x2-x1-1);
  55.     YMax := (y2-y1-1);
  56.   end;
  57.  
  58.   while not KeyPressed do
  59.   begin
  60.     { Plot random pixels }
  61.     RandSeed := Seed;
  62.     I := 0;
  63.     while (not KeyPressed) and (I < NumPts) do
  64.     begin
  65.       Inc(I);
  66.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  67.     end;
  68.  
  69.     { Erase pixels }
  70.     RandSeed := Seed;
  71.     I := 0;
  72.     while (not KeyPressed) and (I < NumPts) do
  73.     begin
  74.       Inc(I);
  75.       X := Random(XMax)+1;
  76.       Y := Random(YMax)+1;
  77.       Color := GetPixel(X, Y);
  78.         if Color = RandColor then
  79.           PutPixel(X, Y, 0);
  80.      end;
  81.   end;
  82.   WaitToGo;
  83. end; { PutPixelPlay }
  84.  
  85. procedure PutImagePlay;
  86. { Demonstrate the GetImage and PutImage commands }
  87.  
  88. const
  89.   r  = 20;
  90.   StartX = 100;
  91.   StartY = 50;
  92.  
  93. var
  94.   CurPort : ViewPortType;
  95.  
  96. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  97. var
  98.   Step : integer;
  99. begin
  100.   Step := Random(2*r);
  101.   if Odd(Step) then
  102.     Step := -Step;
  103.   X := X + Step;
  104.   Step := Random(r);
  105.   if Odd(Step) then
  106.     Step := -Step;
  107.   Y := Y + Step;
  108.  
  109.   { Make saucer bounce off viewport walls }
  110.   with CurPort do
  111.   begin
  112.     if (x1 + X + Width - 1 > x2) then
  113.       X := x2-x1 - Width + 1
  114.     else
  115.       if (X < 0) then
  116.         X := 0;
  117.     if (y1 + Y + Height - 1 > y2) then
  118.       Y := y2-y1 - Height + 1
  119.     else
  120.       if (Y < 0) then
  121.         Y := 0;
  122.   end;
  123. end; { MoveSaucer }
  124.  
  125. var
  126.   Pausetime : word;
  127.   Saucer    : pointer;
  128.   X, Y      : integer;
  129.   ulx, uly  : word;
  130.   lrx, lry  : word;
  131.   Size      : word;
  132.   I         : word;
  133. begin
  134.   ClearDevice;
  135.   FullPort;
  136.  
  137.   { PaintScreen }
  138.   ClearDevice;
  139.   MainWindow('GetImage / PutImage Demonstration');
  140.   StatusLine('Esc aborts or press a key...');
  141.   GetViewSettings(CurPort);
  142.  
  143.   { DrawSaucer }
  144.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  145.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  146.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  147.   Circle(StartX+10, StartY-12, 2);
  148.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  149.   Circle(StartX-10, StartY-12, 2);
  150.   SetFillStyle(SolidFill, MaxColor);
  151.   FloodFill(StartX+1, StartY+4, GetColor);
  152.  
  153.   { ReadSaucerImage }
  154.   ulx := StartX-(r+1);
  155.   uly := StartY-14;
  156.   lrx := StartX+(r+1);
  157.   lry := StartY+(r div 3)+3;
  158.  
  159.   Size := ImageSize(ulx, uly, lrx, lry);
  160.   GetMem(Saucer, Size);
  161.   GetImage(ulx, uly, lrx, lry, Saucer^);
  162. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  163.  
  164.   { Plot some "stars" }
  165.   for I := 1 to 1000 do
  166.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  167.   X := MaxX div 2;
  168.   Y := MaxY div 2;
  169.   PauseTime := 70;
  170.  
  171.   { Move the saucer around }
  172.   repeat
  173. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  174.      Delay(PauseTime);
  175. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  176.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  177.   until KeyPressed;
  178.   FreeMem(Saucer, size);
  179.   WaitToGo;
  180. end; { PutImagePlay }
  181.  
  182. procedure PolyPlay;
  183. { Draw random polygons with random fill styles on the screen }
  184. const
  185.   MaxPts = 5;
  186. type
  187.   PolygonType = array[1..MaxPts] of PointType;
  188. var
  189.   Poly : PolygonType;
  190.   I, Color : word;
  191. begin
  192.   MainWindow('FillPoly demonstration');
  193.   StatusLine('Esc aborts or press a key...');
  194.   repeat
  195.     Color := RandColor;
  196.     SetFillStyle(Random(11)+1, Color);
  197.     SetColor(Color);
  198.     for I := 1 to MaxPts do
  199.       with Poly[I] do
  200.       begin
  201.         X := Random(MaxX);
  202.         Y := Random(MaxY);
  203.       end;
  204.     FillPoly(MaxPts, Poly);
  205.   until KeyPressed;
  206.   WaitToGo;
  207. end; { PolyPlay }
  208.  
  209. procedure FillStylePlay;
  210. { Display all of the predefined fill styles available }
  211. var
  212.   Style    : word;
  213.   Width    : word;
  214.   Height   : word;
  215.   X, Y     : word;
  216.   I, J     : word;
  217.   ViewInfo : ViewPortType;
  218.  
  219. procedure DrawBox(X, Y : word);
  220. begin
  221.   SetFillStyle(Style, MaxColor);
  222.   with ViewInfo do
  223.     Bar(X, Y, X+Width, Y+Height);
  224.   Rectangle(X, Y, X+Width, Y+Height);
  225.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  226.   Inc(Style);
  227. end; { DrawBox }
  228.  
  229. begin
  230.   MainWindow('Pre-defined fill styles');
  231.   GetViewSettings(ViewInfo);
  232.   with ViewInfo do
  233.   begin
  234.     Width := 2 * ((x2+1) div 13);
  235.     Height := 2 * ((y2-10) div 10);
  236.   end;
  237.   X := Width div 2;
  238.   Y := Height div 2;
  239.   Style := 0;
  240.   for J := 1 to 3 do
  241.   begin
  242.     for I := 1 to 4 do
  243.     begin
  244.       DrawBox(X, Y);
  245.       Inc(X, (Width div 2) * 3);
  246.     end;
  247.     X := Width div 2;
  248.     Inc(Y, (Height div 2) * 3);
  249.   end;
  250.   SetTextJustify(LeftText, TopText);
  251.   WaitToGo;
  252. end; { FillStylePlay }
  253.  
  254. procedure FillPatternPlay;
  255. { Display some user defined fill patterns }
  256. const
  257.   Patterns : array[0..11] of FillPatternType = (
  258.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****